home *** CD-ROM | disk | FTP | other *** search
/ Internet Surfer: Getting Started / Internet Surfer - Getting Started (Wayzata Technology)(7231)(1995).bin / pc / mac / bonus / peter_le / finger-1 / my_units / oostatic.uni < prev   
Text File  |  1992-02-24  |  14KB  |  501 lines
  1. unit OOStaticEdit;
  2.  
  3. { This code is part of the Finger/Fingerd source code, written in THINK Pascal 4 }
  4. { Copyright 1991-1992 Peter N Lewis }
  5. { If you use this code, you must give me credit in your about box and documentation }
  6. { This is part of my generic library of routines }
  7.  
  8. interface
  9.  
  10.     type
  11.         TEStaticObject = object
  12.                 window: dialogPtr;
  13.                 titem: integer;
  14.                 vcontrol, hcontrol: controlHandle;
  15.                 te: TEHandle;
  16.                 titemr: rect;
  17.                 hasgrow, drawgrow: boolean; { hasgrow -> leave room for grow icon, drawgrow -> draw it during updates }
  18.                 doubleClickTime, tripleClickTime: longInt;
  19.                 procedure Create (dlg: dialogPtr; item, width: integer; vscroll, hscroll, hasgrowb, drawgrowb: boolean);
  20.                 procedure Destroy;
  21.                 procedure Adjust;
  22.                 procedure Resize;
  23.                 procedure Draw;
  24.                 function EditMenuEnabled: boolean;
  25.                 procedure SetEditMenuItem (item: integer);
  26.                 procedure DoEditMenu (item: integer);
  27.                 procedure DoItemWhere (er: eventRecord; item: integer);
  28.                 procedure DoIdle;
  29.                 procedure DoKey (modifiers: integer; ch: char);
  30.                 procedure DoActivateDeactivate (activate: boolean);
  31.                 procedure ClickLoop;
  32.                 procedure Click (pt: point; extend: boolean);
  33.                 function WordBreak (text: ptr; pos: integer; forward: boolean): boolean;
  34.             end;
  35.  
  36. implementation
  37.  
  38.     uses
  39.         OOMainLoop, BaseGlobals, MyTypes, MyUtils, MyUtilities;
  40.  
  41.     var
  42.         teo: TEStaticObject;
  43.         teOriginalClickLoop: procPtr;
  44.  
  45. { DON'T EVEN THINK ABOUT LOOKING AT THIS CODE!!!!! }
  46.  
  47.     procedure CallCL (addr: procPtr);
  48.     inline
  49.         $205F, $4E90;
  50.  
  51.     procedure SetD0to1;
  52.     inline
  53.         $7001;
  54.  
  55.     function GetD2: longInt;
  56.     inline
  57.         $2F42, $0000;
  58.  
  59.     procedure Unlink;
  60.     inline
  61.         $4E5E;
  62.  
  63.     procedure Link;
  64.     inline
  65.         $4E56, $0000;
  66.  
  67. {$PUSH}
  68. {$D-}
  69.   { Turn debug off, lest our qute little SetD0to1 hack gets crunged by TP }
  70.     procedure CallClickLoop;  { There must be a better way to sort out this crap! }
  71.     begin
  72.         Unlink;  { This is a rediculous hack! }
  73.         CallCL(teOriginalClickLoop);
  74.         Link;
  75.         teo.ClickLoop;
  76.         SetD0to1;
  77.     end;
  78.  
  79.     function CallWordBreak (text: ptr; pos: integer): boolean;
  80.         var
  81.             d2: longInt;
  82.     begin
  83.         d2 := GetD2;
  84.         CallWordBreak := teo.WordBreak(text, pos, BAND(d2, $00020000) = 0);
  85.     end;
  86. {$POP}
  87.  
  88.     function FindEOL (te: TEHandle; loc: integer): integer;
  89.     begin
  90.         while (loc < te^^.teLength) and (ptr(longInt(te^^.hText^) + loc)^ <> 13) do
  91.             loc := loc + 1;
  92.         FindEOL := loc;
  93.     end;
  94.  
  95.     procedure TEStaticObject.Click (pt: point; extend: boolean);
  96.         var
  97.             tc, dct: longInt;
  98.             doubleclick, tripleclick: boolean;
  99.             teOriginalWordBreak: procPtr;
  100.             eol: integer;
  101.     begin
  102.         SetPort(window);
  103.         tc := TickCount;
  104.         doubleclick := tc < doubleClickTime;
  105.         tripleclick := tc < tripleClickTime;
  106.         teo := self;
  107.         teOriginalClickLoop := te^^.clikLoop;
  108.         te^^.clikLoop := @CallClickLoop;
  109.         teOriginalWordBreak := te^^.wordBreak;
  110.         if tripleclick then
  111.             SetWordBreak(@CallWordBreak, te);
  112.         if extend and tripleclick then begin{ we must fake text edit into not shrinking the selection somehow }
  113.             eol := FindEOL(te, te^^.selStart);  { if start<=clickloc<=EOL(start)<selEnd }
  114.             if (te^^.selStart <= te^^.clickloc) and (te^^.clickloc <= eol) and (eol < te^^.selEnd) then
  115.                 TESetSelect(te^^.clickloc, te^^.selEnd, te);
  116.         end;
  117.         TEClick(pt, extend, te);
  118.         tc := TickCount;
  119.         dct := GetDblTime;
  120.         doubleClickTime := tc + dct;
  121.         if doubleclick then
  122.             tripleClickTime := tc + dct;
  123.         te^^.clikLoop := teOriginalClickLoop;
  124.         te^^.wordBreak := teOriginalWordBreak;
  125.     end;
  126.  
  127.     procedure TEStaticObject.Create (dlg: dialogPtr; item, width: integer; vscroll, hscroll, hasgrowb, drawgrowb: boolean);
  128.         var
  129.             dr, vr: rect;
  130.             k: integer;
  131.             h: handle;
  132.     begin
  133.         doubleClickTime := -1;
  134.         tripleClickTime := -1;
  135.         SetPort(dlg);
  136.         window := dlg;
  137.         titem := item;
  138.         hasgrow := hasgrowb;
  139.         drawgrow := drawgrowb;
  140.         if vscroll then begin
  141.             SetRect(dr, 0, 0, 16, 100);
  142.             vcontrol := NewControl(window, dr, '', true, 0, 0, 0, scrollBarProc, 0);
  143.         end
  144.         else
  145.             vcontrol := nil;
  146.         if hscroll then begin
  147.             SetRect(dr, 0, 0, 100, 16);
  148.             hcontrol := NewControl(window, dr, '', true, 0, 0, 0, scrollBarProc, 0);
  149.         end
  150.         else
  151.             hcontrol := nil;
  152.         GetDItem(dlg, titem, k, h, dr);
  153.         titemr := dr;
  154.         EraseRect(dr);
  155.         vr := dr;
  156.         dr.right := dr.left + width;
  157.         te := TENew(dr, vr);
  158.         TEAutoView(true, te);
  159.         Resize;
  160.     end;
  161.  
  162.     procedure TEStaticObject.Destroy;
  163.     begin
  164.         TEDispose(te);
  165.         dispose(self);
  166.     end;
  167.  
  168.     procedure AdjustTE (te: TEHandle; hc, vc: integer);
  169. {Scroll the TERec around to match up to the potentially updated scrollbar}
  170. {values. This is really useful when the window resizes such that the}
  171. {scrollbars become inactive and the TERec had been previously scrolled.}
  172.         var
  173.             value: INTEGER;
  174.     begin
  175.         with te^^ do
  176.             TEScroll((viewRect.left - destRect.left) - hc, (viewRect.top - destRect.top) - (vc * lineHeight), te);
  177.     end; {AdjustTE}
  178.  
  179.     function AdjustHV (isVert: BOOLEAN; control: ControlHandle; te: TEHandle; canRedraw: BOOLEAN): integer;
  180. {Calculate the new control maximum value and current value, whether it is the horizontal or}
  181. {vertical scrollbar. The vertical max is calculated by comparing the number of lines to the}
  182. {vertical size of the viewRect. The horizontal max is calculated by comparing the maximum document}
  183. {width to the width of the viewRect. The current values are set by comparing the offset between}
  184. {the view and destination rects. If necessary and we canRedraw, have the control be re-drawn by}
  185. {calling ShowControl.}
  186.         var
  187.             value, lines, max: INTEGER;
  188.             oldValue, oldMax: INTEGER;
  189.     begin
  190.         oldValue := GetCtlValue(control);
  191.         oldMax := GetCtlMax(control);
  192.         with te^^ do begin
  193.             if isVert then begin
  194.                 lines := nLines;
  195.         {since nLines isn╒t right if the last character is a return, check for that case}
  196.                 if Ptr(ORD(hText^) + teLength - 1)^ = 13 then
  197.                     lines := lines + 1;
  198.                 max := lines - ((viewRect.bottom - viewRect.top) div lineHeight);
  199.             end
  200.             else
  201.                 max := destRect.right - destRect.left - (viewRect.right - viewRect.left);
  202.             if max < 0 then
  203.                 max := 0;            {check for negative values}
  204.             if isVert then
  205.                 value := (viewRect.top - destRect.top) div lineHeight
  206.             else
  207.                 value := viewRect.left - destRect.left;
  208.             if value < 0 then
  209.                 value := 0
  210.             else if value > max then
  211.                 value := max;                    {pin the value to within range}
  212.         end;
  213.         SetCtlMax(control, max);
  214.         SetCtlValue(control, value);
  215.         if canRedraw and ((max <> oldMax) or (value <> oldValue)) then
  216.             ShowControl(control);            {check to see if the control can be re-drawn}
  217.         AdjustHV := value;
  218.     end; {AdjustHV}
  219.  
  220.     procedure TEStaticObject.Adjust;
  221.         var
  222.             hc, vc: integer;
  223.     begin
  224.         vc := AdjustHV(true, vcontrol, te, false);
  225.         hc := AdjustHV(false, hcontrol, te, false);
  226.         AdjustTE(te, hc, vc);
  227.     end; {AdjustScrollValues}
  228.  
  229.     procedure TEStaticObject.Resize;
  230.         const
  231.             invis = 0;
  232.             vis = 255;
  233.             inset = 3;
  234.         var
  235.             dr, vr, r, tr: rect;
  236.             pt: point;
  237.             k: integer;
  238.             h: handle;
  239.             wd, ht: integer;
  240.             hc, vc: integer;
  241.     begin
  242.         SetPort(window);
  243.         EraseRect(titemr);
  244.         GetDItem(window, titem, k, h, tr);
  245.         titemr := tr;
  246.         InvalRect(tr);
  247.         vr := tr;
  248.         InsetRect(vr, inset, inset);
  249.         if hcontrol <> nil then
  250.             vr.bottom := vr.bottom - 15;
  251.         if vcontrol <> nil then
  252.             vr.right := vr.right - 15;
  253.         vr.bottom := vr.top + (vr.bottom - vr.top) div te^^.lineHeight * te^^.lineHeight;
  254.  
  255.         pt := vr.topleft;
  256.         SubPt(te^^.viewRect.topleft, pt);
  257.         OffsetRect(te^^.destRect, pt.h, pt.v);
  258.  
  259.         te^^.viewRect := vr;
  260.  
  261.         if vcontrol <> nil then begin
  262.             vcontrol^^.contrlVis := invis;
  263.             MoveControl(vcontrol, tr.right - 16, tr.top);
  264.             ht := tr.bottom - tr.top;
  265.             if hasgrow then
  266.                 ht := ht - 15;
  267.             SizeControl(vcontrol, 16, ht);
  268.             vc := AdjustHV(true, vcontrol, te, false);
  269.             vcontrol^^.contrlVis := vis;
  270.         end;
  271.         if hcontrol <> nil then begin
  272.             hcontrol^^.contrlVis := invis;
  273.             MoveControl(hcontrol, tr.left, tr.bottom - 16);
  274.             ht := tr.right - tr.left;
  275.             if hasgrow or (vcontrol <> nil) then
  276.                 ht := ht - 15;
  277.             SizeControl(hcontrol, ht, 16);
  278.             hc := AdjustHV(false, hcontrol, te, false);
  279.             hcontrol^^.contrlVis := vis;
  280.         end;
  281.         AdjustTE(te, hc, vc);
  282.     end;
  283.  
  284.     procedure TEStaticObject.Draw;
  285.         var
  286.             r: rect;
  287.             pt: point;
  288.             k: integer;
  289.             h: handle;
  290.     begin
  291.         GetDItem(window, titem, k, h, r);
  292.         EraseRect(r);
  293.         if drawgrow then begin
  294. {    PlotSICN(grow_sicn_id, grow_sicn_index, r.bottom - 16, r.right - 16);}
  295.             DrawGrowIcon(window);
  296.         end;
  297.         if vcontrol <> nil then begin
  298.             Draw1Control(vcontrol);
  299.         end;
  300.         if hcontrol <> nil then begin
  301.             Draw1Control(hcontrol);
  302.         end;
  303.         EraseRect(te^^.viewRect);
  304.         TEUpdate(te^^.viewRect, te);
  305.     end;
  306.  
  307.     procedure TEStaticObject.DoActivateDeactivate (activate: boolean);
  308.     begin
  309.         if drawgrow then
  310.             DrawGrowIcon(window);
  311.         if activate then
  312.             TEActivate(te)
  313.         else
  314.             TEDeactivate(te);
  315.     end;
  316.  
  317. { Common algorithm for pinning the value of a control. It returns the actual amount }
  318. { the value of the control changed. }
  319.     procedure CommonAction (control: ControlHandle; var amount: integer);
  320.         var
  321.             value, max: integer;
  322.     begin
  323.         value := GetCtlValue(control);
  324.         max := GetCtlMax(control);
  325.         amount := value - amount;
  326.         if (amount <= 0) then
  327.             amount := 0
  328.         else if (amount >= max) then
  329.             amount := max;
  330.         SetCtlValue(control, amount);
  331.         amount := value - amount;   { calculate true change }
  332.     end; { CommonAction  }
  333.  
  334.     var
  335.         actionTE: TEHandle;
  336.  
  337. { Determines how much to change the value of the vertical scrollbar by and how }
  338. { much to scroll the TE record.}
  339.     procedure VActionProc (control: ControlHandle; part: integer);
  340.         var
  341.             amount: integer;
  342.             window: WindowPtr;
  343.     begin
  344.         if (part <> 0) then begin
  345.             window := control^^.contrlOwner;
  346.             case part of
  347.                 inUpButton, inDownButton:        { one line  }
  348.                     amount := 1;
  349.                 inPageUp, inPageDown:            { one page  }
  350.                     with actionTE^^, viewRect do
  351.                         amount := (bottom - top) div lineHeight;
  352.             end;
  353.             if ((part = inDownButton) or (part = inPageDown)) then
  354.                 amount := -amount;        { reverse direction for a downer  }
  355.             CommonAction(control, amount);
  356.             if (amount <> 0) then
  357.                 TEScroll(0, amount * actionTE^^.lineHeight, actionTE);
  358.         end;
  359.     end; { VActionProc }
  360.  
  361. { Determines how much to change the value of the horizontal scrollbar by and how }
  362. { much to scroll the TE record. }
  363.     procedure HActionProc (control: ControlHandle; part: integer);
  364.         var
  365.             amount: integer;
  366.             window: WindowPtr;
  367.     begin
  368.         if (part <> 0) then begin
  369.             window := control^^.contrlOwner;
  370.             case part of
  371.                 inUpButton, inDownButton:        { a few pixels }
  372.                     amount := 8;
  373.                 inPageUp, inPageDown:            { a page width }
  374.                     with actionTE^^.viewRect do
  375.                         amount := (right - left);
  376.             end;
  377.             if ((part = inDownButton) or (part = inPageDown)) then
  378.                 amount := -amount;        { reverse direction }
  379.             CommonAction(control, amount);
  380.             if (amount <> 0) then
  381.                 TEScroll(amount, 0, actionTE);
  382.         end;
  383.     end; { HActionProc }
  384.  
  385. { Gets called from CallClickLoop which in turn }
  386. { is called by the TEClick toolbox routine. Saves the window's clip region, }
  387. { sets it to the portRect, adjusts the scrollbar values to match the TE scroll }
  388. { amount, then restores the clip region. }
  389.     procedure TEStaticObject.ClickLoop;
  390.         var
  391.             region: RgnHandle;
  392.             vc, hc: integer;
  393.     begin
  394.         SetPort(window);
  395.         region := NewRgn;
  396.         GetClip(region);                { save the old clip }
  397.         ClipRect(window^.portRect);        { set the new clip }
  398.         vc := AdjustHV(true, vcontrol, te, false);
  399.         hc := AdjustHV(false, hcontrol, te, false);
  400.         SetClip(region);                { restore the old clip }
  401.         DisposeRgn(region);
  402.     end; { PascalClikLoop }
  403.  
  404.     function TEStaticObject.WordBreak (text: ptr; pos: integer; forward: boolean): boolean;
  405.     begin
  406.         if forward then
  407.             WordBreak := (pos > 0) and (ptr(longInt(text) + pos - 1)^ = 13)
  408.         else
  409.             WordBreak := ptr(longInt(text) + pos)^ = 13
  410.     end;
  411.  
  412.     procedure TEStaticObject.DoItemWhere (er: eventRecord; item: integer);
  413.         var
  414.             control: controlHandle;
  415.             value, part: integer;
  416.     begin
  417.         SetPort(window);
  418.         GlobalToLocal(er.where);
  419.         part := FindControl(er.where, window, control);
  420.         if part = 0 then begin
  421.             if PtInRect(er.where, te^^.viewRect) then
  422.                 Click(er.where, BAND(er.modifiers, shiftKey) <> 0)
  423.         end
  424.         else begin
  425.             if part = inThumb then begin
  426.                 value := GetCtlValue(control);
  427.                 part := TrackControl(control, er.where, nil);
  428.                 if part <> 0 then begin
  429.                     value := value - GetCtlValue(control);
  430.                     if value <> 0 then
  431.                         if control = vcontrol then
  432.                             TEScroll(0, value * te^^.lineHeight, te)
  433.                         else
  434.                             TEScroll(value, 0, te);
  435.                 end;
  436.             end
  437.             else begin
  438.                 actionTE := te;
  439.                 if control = vcontrol then
  440.                     value := TrackControl(control, er.where, @VActionProc)
  441.                 else
  442.                     value := TrackControl(control, er.where, @HActionProc);
  443.             end;
  444.         end;
  445.     end;
  446.  
  447.     function TEStaticObject.EditMenuEnabled: boolean;
  448.         var
  449.             i: integer;
  450.     begin
  451.         for i := EMundo to EMselectall do
  452.             if i <> EMundo + 1 then
  453.                 SetEditMenuItem(i);
  454.         EditMenuEnabled := (te^^.selStart < te^^.selEnd) or (te^^.teLength > 0);
  455.     end;
  456.  
  457.     procedure TEStaticObject.SetEditMenuItem (item: integer);
  458.     begin
  459.         case item of
  460.             EMundo, EMcut, EMpaste, EMclear:  { Can't undo, cut, copy, paste in a static edit thingy }
  461.                 SetIDItemEnable(M_Edit, item, false);
  462.             EMcopy: 
  463.                 SetIDItemEnable(M_Edit, item, te^^.selStart < te^^.selEnd);  { Can copy iff there is a selection }
  464.             EMselectall: 
  465.                 SetIDItemEnable(M_Edit, item, te^^.teLength > 0);  { Can select all iff there is something to select }
  466.             otherwise
  467.         end;
  468.     end;
  469.  
  470.     procedure TEStaticObject.DoEditMenu (item: integer);
  471.         var
  472.             oe: OSErr;
  473.             loe: longInt;
  474.     begin
  475.         case item of
  476.             EMcopy:  begin
  477.                 TECopy(te);
  478.                 loe := ZeroScrap;
  479.                 oe := TEToScrap;
  480.             end;
  481.             EMselectall:  begin
  482.                 SetPort(window);
  483.                 TESetSelect(0, maxLongInt, te);
  484.             end;
  485.             otherwise
  486.         end;
  487.     end;
  488.  
  489.     procedure TEStaticObject.DoIdle;
  490.     begin
  491.         TEIdle(te);
  492.     end;
  493.  
  494.     procedure TEStaticObject.DoKey (modifiers: integer; ch: char);
  495.     begin
  496.         if BAND(modifiers, cmdKey) = 0 then
  497.             TEKey(ch, te);
  498.         Adjust;
  499.     end;
  500.  
  501. end.